home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / about.tk < prev    next >
Encoding:
Text File  |  1995-11-06  |  3.0 KB  |  123 lines

  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # do an about box
  8. # 1) walk Spec in from the left
  9. # 2) walk T, c, l in from the right
  10. # 3) walk magnifying glass in from the right
  11. # 4) turn each of T, c, l bigger (and red) as the
  12. #    magnifying glass goes by
  13.  
  14.  
  15. foreach image [array names About] {
  16.     image create bitmap $image -data $About($image)
  17. }
  18. catch "unset About"
  19. proc about  {} {
  20.     global Tags P
  21.     if {[winfo exists .about]} return
  22.     toplevel .about
  23.     wm title .about "$P(title) - about"
  24.     # render latent after commands harmless
  25.     bind .about <Destroy> {proc %W args {}}
  26.     set c .about.c
  27.     canvas $c
  28.     blt_table .about .about.c 0,0 -fill both
  29.     set w [image width spec]
  30.     set h [image height spec]
  31.     wm geometry .about [expr 2 * $w]x[expr 200 + $h]
  32.     tkwait visibility .about
  33.  
  34.     # draw "spec"
  35.     set after 0
  36.     $c create image -$w 30 -anchor nw -image spec -tag spec
  37.     for {set i 0} {$i < $w} {incr i 10} {
  38.         after [incr after 100] "$c move spec 10 0"
  39.     }
  40.  
  41.     # draw "tcl"
  42.  
  43.     incr after 500
  44.     set ww [expr 2 * $w + 50]
  45.     set offset $w
  46.     incr offset 35
  47.     set y0 [image height lt]
  48.     incr y0 35
  49.     foreach img {t c l} {
  50.         set indx [$c create image $ww $y0 -anchor sw -image l$img -tag "l$img small"]
  51.         set Tags($indx) $img
  52.         for {set i $ww} {$i > $offset} {incr i -8} {
  53.             after [incr after 50] "$c move l$img -8 0"
  54.         }
  55.         incr offset [image width l$img]
  56.         incr offset 3
  57.     }
  58.  
  59.     # Make "the glass"
  60.  
  61.     $c create oval 0 0 170 170 -width 6 -outline blue \
  62.         -stipple gray25 -fill #88f -tag "glass ring"
  63.     $c create line 140 150 180 200 -width 20 -tag glass
  64.     $c move glass $ww -15
  65.     incr offset -163
  66.     for {set i $ww} {$i > $offset} {incr i -10} {
  67.         after [incr after 75] "$c move glass -10 0; about_check $c"
  68.     }
  69.  
  70.     # now for the text
  71.  
  72.     set message "
  73.         SpecTcl Version 0.1
  74.         by
  75.         Stephen Uhler
  76.         \xa9 Sun Microsystems Laboratories
  77.         
  78.         spectcl@tcl.eng.sun.com
  79.     "
  80.  
  81.     incr after 500
  82.     $c create text $w $h -text $message \
  83.             -justify center -anchor n -tag text
  84.     $c move text 0 200
  85.     for {set i 200} {$i > $h} {incr i -10} {
  86.         after [incr after 75] "$c move text 0 -10"
  87.     }
  88.     incr after 500
  89.     for {set i 200} {$i > $h} {incr i -10} {
  90.         after [incr after 75] "$c move ok 0 -10"
  91.     }
  92.  
  93.     # now go away
  94.  
  95.     button $c.b -text OK -bd 5  -fg blue -command "destroy .about" \
  96.         -highlightthickness 4 -highlightcolor red
  97.     $c create window 20 $h -anchor nw -tag ok -window $c.b
  98.     $c move ok 0 200
  99.     focus $c.b
  100.     # grab .about        ;# don't need it
  101. }
  102.  
  103. # check the glass entering the letters, and grow them
  104.  
  105. proc about_check {c} {
  106.     global Tags
  107.     set cover [$c bbox ring]
  108.     set in [eval {$c find enclosed} $cover]        
  109.     foreach i $in {
  110.         if {![info exists Tags($i)]} return
  111.         set bbox [$c bbox $i]
  112.         scan [$c bbox $i] "%d %d %d %d" x0 y0 x1 y1
  113.         $c delete $i
  114.         set x [expr ($x0 + $x1)/2]
  115.         set y [expr ($y0 + $y1)/2]
  116.         $c create image $x $y -anchor c -image b$Tags($i)
  117.         after 100 [b$Tags($i) configure -foreground red]
  118.         unset Tags($i)
  119.         $c raise ring
  120.     }
  121. }
  122.  
  123.